home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok58 / multimem / multimem.mod < prev    next >
Text File  |  1993-11-04  |  3KB  |  116 lines
  1. (*************************************************************************
  2.  
  3. :Program.    MultiMem.mod
  4. :Contents.   Manages multible intepentend Memory-Heaps
  5. :Author.     Hartmut Goebel
  6. :Address.    Aufseßplatz 5, D-8500 Nürnberg 40
  7. :Copyright.  Copyright © 1991 by Hartmut Goebel
  8. :Copyright.  Freeware, feel free to Copy it, but let Copyright-note intact
  9. :Language.   Oberon
  10. :Translator. Amiga Oberon V2.00
  11. :History.    V1.0, 02 Jun 1991, hartmut Goebel
  12. :Date.       26 Aug 1991 18:52:06
  13.  
  14. :Support.    Fridjof Siebert (Mem-Handling in OberonLib)
  15.  
  16. *************************************************************************)
  17.  
  18. MODULE MultiMem;
  19.  
  20. IMPORT
  21.   Exec, ol: OberonLib, sys: SYSTEM;
  22.  
  23. TYPE
  24.   HeapPtr* = POINTER TO Heap;
  25.   Heap = STRUCT (node: Exec.MinNode);
  26.      list: Exec.MinList;
  27.   END;
  28.  
  29.   MemElementPtr = POINTER TO MemElement;
  30.   MemElement = STRUCT (node: Exec.MinNode);
  31.     size: LONGINT; (* the hunk's size          *)
  32.     mem: INTEGER;  (* and the actual hunk data *)
  33.   END;
  34.  
  35. VAR
  36.   HeapList: Exec.MinList;
  37.   el1,el2: MemElementPtr;
  38.   h1,h2: HeapPtr;
  39.  
  40. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  41.  
  42. PROCEDURE New*(heap: HeapPtr; VAR adr: LONGINT; size: LONGINT);
  43. BEGIN
  44.   INC(size,sys.SIZE(Exec.MinNode)+sys.SIZE(LONGINT));
  45.   el1 := Exec.AllocMem(size,ol.MemReqs);
  46.   IF el1=NIL THEN adr := NIL; RETURN END;
  47.   el1.size := size;
  48.   Exec.AddHead(heap.list,el1);
  49.   adr := sys.ADR(el1.mem);
  50. END New;
  51.  
  52.  
  53. PROCEDURE Dispose*(VAR adr: LONGINT);
  54. BEGIN
  55.   IF adr#NIL THEN
  56.     el1 := adr-(sys.SIZE(Exec.MinNode)+sys.SIZE(LONGINT));
  57.     Exec.Remove(el1);
  58.     Exec.FreeMem(el1,el1.size);
  59.     adr := NIL;
  60.   END;
  61. END Dispose;
  62.  
  63.  
  64. PROCEDURE NewHeap*(VAR heap: HeapPtr);
  65. BEGIN
  66.   heap := Exec.AllocMem(sys.SIZE(Heap),ol.MemReqs);
  67.   IF heap#NIL THEN
  68.     Exec.AddHead(HeapList,heap);
  69.     heap.list.head     := sys.ADR(heap.list.tail);
  70.     heap.list.tailPred := sys.ADR(heap.list.head);
  71.     heap.list.tail     := NIL;
  72.   END;
  73. END NewHeap;
  74.  
  75.  
  76. PROCEDURE EmptyHeap*(heap: HeapPtr);
  77. BEGIN
  78.   el1 := heap.list.head;
  79.   LOOP
  80.     el2 := el1.node.succ;
  81.     IF el2=NIL THEN EXIT END;
  82.     Exec.FreeMem(el1,el1.size);
  83.     el1 := el2;
  84.   END;
  85. END EmptyHeap;
  86.  
  87.  
  88. PROCEDURE DisposeHeap*(VAR heap: HeapPtr);
  89. BEGIN
  90.   IF heap#NIL THEN
  91.     EmptyHeap(heap);
  92.     Exec.Remove(heap);
  93.     Exec.FreeMem(heap,sys.SIZE(Heap));
  94.     heap := NIL;
  95.   END;
  96. END DisposeHeap;
  97.  
  98.  
  99. BEGIN
  100.   HeapList.head     := sys.ADR(HeapList.tail);
  101.   HeapList.tailPred := sys.ADR(HeapList.head);
  102.   HeapList.tail     := NIL;
  103.  
  104. CLOSE
  105.   h1 := HeapList.head;
  106.   LOOP
  107.     h2 := h1.node.succ;
  108.     IF h2=NIL THEN EXIT END;
  109.     EmptyHeap(h1);
  110.     Exec.FreeMem(h1,sys.SIZE(Heap));
  111.     h1 := h2
  112.   END;
  113.  
  114. END MultiMem.
  115.  
  116.